Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue45/Alfresco/AALZSWin.PAS

Pascal/Delphi Source File | 2000-11-02 | 12.5 KB | 377 lines

{*********************************************************}
{* AALZSWin                                              *}
{* Copyright (c) Julian M Bucknall 1998-1999             *}
{* All rights reserved.                                  *}
{*********************************************************}
{* Algorithms Alfresco LZ77 unit - sliding window        *}
{*********************************************************}

{Note: this unit is released as freeware. In other words, you are free
       to use this unit in your own applications, however I retain all
       copyright to the code. JMB}

unit AALZSWin;

interface

uses
  SysUtils,
  Classes,
  AALZBase;

{Notes: TaaLZSlidingWindow implements a sliding window on data for
        the Algorithms Alfresco LZ77 implementation. The sliding
        window class can be used in two ways: for compression and for
        decompression.

        For compression, the stream passed to the class is
        automatically read when required to keep the internal buffer
        fully loaded. The property GetNextKey returns the 3 character
        string at the current position ready for the hashing routine.
        (Note that right at the end of the input stream a two or less
        character string will be returned - this is a signal to end
        the compression phase.) Advance will move the sliding window
        on by one character (or as many that are specified - depends
        on the match). Compare will compare the string at the current
        position with that at the given offset (note that this is an
        offset into the input stream and not the position in the
        sliding window) and will return the number of matched
        characters.

        For decompression, the stream passed to the class is the
        output stream (the decompressed stream). The decompressor will
        either call AddChar to add a literal character at the current
        position and advance by one, or will call AddCode to decode
        a distance/length pair and advance the stream on by as many
        characters as is decoded. The class will periodically update
        the stream from the internal buffer.
        }


{This compiler define adds some extra checking at the start of each
 interfaced method to ensure that the sliding window is used in the
 correct mode.}
{$IFOPT D+}
  {$DEFINE InDebugMode}
{$ENDIF}

type
  TaaLZSlidingWindow = class
    private
      swCompressing : boolean;
      swStart       : PChar;
      swCurrent     : PChar;
      swLookAheadEnd: PChar;
      swMidPoint    : PChar;
      swBuffer      : PChar;
      swBufferEnd   : PChar;
      swStream      : TStream;
      swStartOffset : longint;
    protected
      procedure swAdvanceAfterAdd(aCount : integer);
      procedure swReadFromStream;
      procedure swSetCapacity(aValue : longint);
      procedure swWriteToStream(aFinalBlock : boolean);
    public
      constructor Create(aStream      : TStream;
                         aCompressing : boolean);
      destructor Destroy; override;

      {methods used for both compression and decompression}
      procedure Clear;

      {methods used during compression}
      procedure Advance(aCount : integer);
      function Compare(aOffset   : longint;
                   var aDistance : integer) : integer;
      procedure GetNextKey(var aMS     : TaaLZKey;
                           var aOffset : longint);

      {methods used during decompression}
      procedure AddChar(aCh : char);
      procedure AddCode(aDistance : integer; aLength : integer);
  end;

implementation

{Notes:
        Meaning of the internal pointers:

        |----------+===================+==+--------------------------|
        |          |                   |  |                          |
        swBuffer   swStart     swCurrent  swLookAheadEnd   swBufferEnd

        The valid data is between swStart and swLookAheadEnd when
        compressing, and between swStart and swCurrent when
        decompressing (swLookAheadEnd not being used in this latter
        case). Usually the difference between swStart and swCurrent is
        4096, the size of the sliding window.
        }

{===Helper routines==================================================}
procedure NotEnoughDataError(aAvail, aReq : integer);
begin
  raise Exception.Create(
          Format('Not enough data in queue (%s bytes) to satisfy read request (%s bytes)',
                 [aAvail, aReq]));
end;
{--------}
procedure CannotWriteError(aToWrite, aWritten : integer);
begin
  raise Exception.Create(
          Format('Attempted to write %d bytes to stream, but only %d bytes got written',
                 [aToWrite, aWritten]));
end;
{--------}
procedure InvalidUseError(aCompressing : boolean;
                    const aMethodName  : string);
const
  CompressStr : array [boolean] of string[13] =
                ('decompression', 'compression');
begin
  raise Exception.Create(
           Format('%s method cannot be used during %s',
                  [aMethodName, CompressStr[aCompressing]]));
end;
{====================================================================}


{===TaaLZSlidingWindow=============================================}
constructor TaaLZSlidingWindow.Create(aStream      : TStream;
                                      aCompressing : boolean);
begin
  inherited Create;
  {save parameters}
  swCompressing := aCompressing;
  swStream := aStream;
  {set capacity of sliding window: by definition this is 4096 bytes of
   sliding window and 18 bytes of lookahead}
  swSetCapacity(aalzSlidingWindowSize + aalzLookAheadSize);
  {reset the buffer and, if we're compressing, read some data from the
   stream to be compressed}
  Clear;
  if aCompressing then
    swReadFromStream;
end;
{--------}
destructor TaaLZSlidingWindow.Destroy;
begin
  if Assigned(swBuffer) then begin
    {finish writing to the output stream if we're decompressing}
    if not swCompressing then
      swWriteToStream(true);
    {free the buffer}
    FreeMem(swBuffer, swBufferEnd - swBuffer);
  end;
  inherited Destroy;
end;
{--------}
procedure TaaLZSlidingWindow.AddChar(aCh : char);
begin
  {$IFDEF InDebugMode}
  {this is a decompression routine only}
  if swCompressing then
    InvalidUseError(swCompressing, 'AddChar');
  {$ENDIF}
  {add the character to the buffer}
  swCurrent^ := aCh;
  {advance the start of the sliding window}
  swAdvanceAfterAdd(1);
end;
{--------}
procedure TaaLZSlidingWindow.AddCode(aDistance : integer; aLength : integer);
var
  FromChar : PChar;
  ToChar   : PChar;
  i        : integer;
begin
  {$IFDEF InDebugMode}
  {this is a decompression routine only}
  if swCompressing then
    InvalidUseError(swCompressing, 'AddCode');
  {$ENDIF}
  {set up the pointers to do the data copy; note we cannot use Move
   since part of the data we are copying may be set up by the actual
   copying of the data}
  FromChar := swCurrent - aDistance;
  ToChar := swCurrent;
  for i := 1 to aLength do begin
    ToChar^ := FromChar^;
    inc(FromChar);
    inc(ToChar);
  end;
  {advance the start of the sliding window}
  swAdvanceAfterAdd(aLength);
end;
{--------}
procedure TaaLZSlidingWindow.Advance(aCount : integer);
var
  ByteCount   : integer;
begin
  {$IFDEF InDebugMode}
  {this is a compression routine only}
  if not swCompressing then
    InvalidUseError(swCompressing, 'Advance');
  {$ENDIF}
  {advance the start of the sliding window, if required}
  if ((swCurrent - swStart) >= aalzSlidingWindowSize) then begin
    inc(swStart, aCount);
    inc(swStartOffset, aCount);
  end;
  {advance the current pointer}
  inc(swCurrent, aCount);
  {check to see if we have advanced into the overflow zone}
  if (swStart >= swMidPoint) then begin
    {move current data back to the start of the buffer}
    ByteCount := swLookAheadEnd - swStart;
    Move(swStart^, swBuffer^, ByteCount);
    {reset the various pointers}
    ByteCount := swStart - swBuffer;
    swStart := swBuffer;
    dec(swCurrent, ByteCount);
    dec(swLookAheadEnd, ByteCount);
    {read some more data from the stream}
    swReadFromStream;
  end;
end;
{--------}
procedure TaaLZSlidingWindow.Clear;
begin
  swStart := swBuffer;
  swCurrent := swBuffer;
  swLookAheadEnd := swBuffer;
  swStartOffset := 0;
end;
{--------}
function TaaLZSlidingWindow.Compare(aOffset   : longint;
                                var aDistance : integer) : integer;
var
  MatchStr  : PChar;
  CurrentCh : PChar;
begin
  {Note: when this routine is called it is assumed that at least three
         characters will match between the passed position and the
         current position}
  {$IFDEF InDebugMode}
  {this is a compression routine only}
  if not swCompressing then
    InvalidUseError(swCompressing, 'Compare');
  {$ENDIF}
  {calculate the position in the sliding window for the passed offset
   and its distance from the current position}
  MatchStr := swStart + (aOffset - swStartOffset);
  aDistance := swCurrent - MatchStr;
  inc(MatchStr, 3);
  {calculate the length of the matching characters between this and
   the current position. Don't go above the maximum length. Have a
   special case for the end of the input stream}
  Result := 3;
  CurrentCh := swCurrent + 3;
  if (CurrentCh <> swLookAheadEnd) then begin
    while (Result < aalzMaxMatchLength) and
          (MatchStr^ = CurrentCh^) do begin
      inc(Result);
      inc(MatchStr);
      inc(CurrentCh);
      if (CurrentCh = swLookAheadEnd) then
        Break;
    end;
  end;
end;
{--------}
procedure TaaLZSlidingWindow.GetNextKey(var aMS     : TaaLZKey;
                                        var aOffset : longint);
var
  P : PChar;
  i : integer;
begin
  {$IFDEF InDebugMode}
  {this is a compression routine only}
  if not swCompressing then
    InvalidUseError(swCompressing, 'GetNextKey');
  {$ENDIF}
  {calculate the length of the match string; usually it's 3, but at
   the end of the input stream it could be 2 or less.}
  if ((swLookAheadEnd - swCurrent) < 3) then
    aMS.AsString[0] := char(swLookAheadEnd - swCurrent)
  else
    aMS.AsString[0] := #3;
  P := swCurrent;
  for i := 1 to length(aMS.AsString) do begin
    aMS.AsString[i] := P^;
    inc(P);
  end;
  aOffset := swStartOffset + (swCurrent - swStart);
end;
{--------}
procedure TaaLZSlidingWindow.swAdvanceAfterAdd(aCount : integer);
begin
  {advance the start of the sliding window, if required}
  if ((swCurrent - swStart) >= aalzSlidingWindowSize) then begin
    inc(swStart, aCount);
    inc(swStartOffset, aCount);
  end;
  {advance the current pointer}
  inc(swCurrent, aCount);
  {check to see if we have advanced into the overflow zone}
  if (swStart >= swMidPoint) then begin
    {write some more data to the stream (from swBuffer to swStart)}
    swWriteToStream(false);
    {move current data back to the start of the buffer}
    Move(swStart^, swBuffer^, swCurrent - swStart);
    {reset the various pointers}
    dec(swCurrent, swStart - swBuffer);
    swStart := swBuffer;
  end;
end;
{--------}
procedure TaaLZSlidingWindow.swReadFromStream;
var
  BytesRead   : longint;
  BytesToRead : longint;
begin
  {read some more data into the look ahead zone}
  BytesToRead := swBufferEnd - swLookAheadEnd;
  BytesRead := swStream.Read(swLookAheadEnd^, BytesToRead);
  inc(swLookAheadEnd, BytesRead);
end;
{--------}
procedure TaaLZSlidingWindow.swSetCapacity(aValue : longint);
var
  NewQueue  : PChar;
begin
  {round the requested capacity to nearest 64 bytes}
  aValue := (aValue + 63) and $7FFFFFC0;
  {get a new buffer}
  GetMem(NewQueue, aValue * 2);
  {destroy the old buffer}
  if (swBuffer <> nil) then
    FreeMem(swBuffer, swBufferEnd - swBuffer);
  {set the head/tail and other pointers}
  swBuffer := NewQueue;
  swStart := NewQueue;
  swCurrent := NewQueue;
  swLookAheadEnd := NewQueue;
  swBufferEnd := NewQueue + (aValue * 2);
  swMidPoint := NewQueue + aValue;
end;
{--------}
procedure TaaLZSlidingWindow.swWriteToStream(aFinalBlock : boolean);
var
  BytesWritten : longint;
  BytesToWrite : longint;
begin
  {write the data before the current sliding window}
  if aFinalBlock then
    BytesToWrite := swCurrent - swBuffer
  else
    BytesToWrite := swStart - swBuffer;
  BytesWritten := swStream.Write(swBuffer^, BytesToWrite);
  if (BytesWritten <> BytesToWrite) then
    CannotWriteError(BytesToWrite, BytesWritten);
end;
{====================================================================}

end.